--- Kleisli operators, 'Arrow' and 'Monad' instances
package frege.control.arrow.Kleisli where

import frege.Prelude hiding (id, .) -- will not be necessary
import frege.control.Semigroupoid
-- import frege.control.Category
import frege.control.Arrow

data Kleisli m a b = Kleisli { run :: a -> m b }

instance Monad m => Arrow (Kleisli m) where
  id = Kleisli return

  Kleisli f . Kleisli g = Kleisli (f <=< g)

  arr f = Kleisli (return . f)

  first (Kleisli k) = Kleisli (\(b, d) -> fmap (\c -> (c, d)) (k b))

  second (Kleisli k) = Kleisli (\(a, c) -> fmap (\d -> (a, d)) (k c))

  Kleisli f *** Kleisli g = Kleisli go
    where
      go (a, c) = (,) <$> f a <*> g c

  Kleisli f &&& Kleisli g = Kleisli go
    where
      go a = (,) <$> f a <*> g a

instance Monad m => Monad (Kleisli m a) where
  pure b = Kleisli (\_ -> return b)

  fmap f (Kleisli k) = Kleisli (fmap f . k)

  Kleisli kf <*> Kleisli kb = Kleisli go
    where
      go a = do
        f <- kf a
        b <- kb a
        return (f b)

  Kleisli k >>= f = Kleisli go
    where
      go a = do
        b <- k a
        (f b).run a
